home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / acodec1g / ftpbrws.frm next >
Text File  |  1998-06-15  |  7KB  |  211 lines
  1. VERSION 5.00
  2. Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form frmFTPBrowse 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "FTP Browser"
  7.    ClientHeight    =   4155
  8.    ClientLeft      =   45
  9.    ClientTop       =   330
  10.    ClientWidth     =   5040
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   4155
  14.    ScaleWidth      =   5040
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.TextBox txtContents 
  17.       Height          =   3735
  18.       Left            =   120
  19.       MultiLine       =   -1  'True
  20.       ScrollBars      =   2  'Vertical
  21.       TabIndex        =   2
  22.       Top             =   360
  23.       Width           =   4815
  24.    End
  25.    Begin VB.Timer tmrSaveFile 
  26.       Enabled         =   0   'False
  27.       Interval        =   10
  28.       Left            =   3480
  29.       Top             =   4560
  30.    End
  31.    Begin MSComDlg.CommonDialog dlgSave 
  32.       Left            =   2160
  33.       Top             =   4440
  34.       _ExtentX        =   847
  35.       _ExtentY        =   847
  36.       _Version        =   393216
  37.       FontSize        =   1.17491e-38
  38.    End
  39.    Begin InetCtlsObjects.Inet inetBrowse 
  40.       Left            =   2760
  41.       Top             =   4440
  42.       _ExtentX        =   1005
  43.       _ExtentY        =   1005
  44.       _Version        =   393216
  45.       Protocol        =   2
  46.       RemotePort      =   21
  47.       URL             =   "ftp://"
  48.    End
  49.    Begin VB.TextBox txtAddress 
  50.       Height          =   285
  51.       Left            =   840
  52.       TabIndex        =   1
  53.       Top             =   0
  54.       Width           =   4095
  55.    End
  56.    Begin VB.Label Label1 
  57.       Caption         =   "&Address:"
  58.       Height          =   255
  59.       Left            =   120
  60.       TabIndex        =   0
  61.       Top             =   0
  62.       Width           =   735
  63.    End
  64. End
  65. Attribute VB_Name = "frmFTPBrowse"
  66. Attribute VB_GlobalNameSpace = False
  67. Attribute VB_Creatable = False
  68. Attribute VB_PredeclaredId = True
  69. Attribute VB_Exposed = False
  70. Option Explicit
  71. Dim mstrTempDir As String
  72. Dim mstrDir As String
  73.  
  74. 'API function
  75. Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
  76.     (ByVal nBufferLength As Long, _
  77.     ByVal lpBuffer As String) As Long
  78.  
  79.  
  80. 'Get Windows temporary file path
  81. Private Sub Form_Load()
  82.     Dim lngLen As Long
  83.     lngLen = 144
  84.     mstrTempDir = Space(lngLen)
  85.     lngLen = GetTempPath(lngLen, mstrTempDir)
  86.     mstrTempDir = Left(mstrTempDir, lngLen)
  87. End Sub
  88.  
  89. Private Sub txtAddress_KeyPress(KeyAscii As Integer)
  90.     If KeyAscii = Asc(vbCr) Then
  91.         'Eat keystroke
  92.         KeyAscii = 0
  93.         'Select text
  94.         txtAddress.SelStart = 0
  95.         txtAddress.SelLength = Len(txtAddress)
  96.         On Error GoTo errOpenURL
  97.         'Set FTP address to view
  98.         inetBrowse.URL = txtAddress
  99.         'Get directory
  100.         inetBrowse.Execute , "Dir "
  101.         txtAddress = inetBrowse.URL
  102.     End If
  103.     Exit Sub
  104. errOpenURL:
  105.     Select Case Err.Number
  106.         Case icBadUrl
  107.             MsgBox "Bad address. Please reenter."
  108.         Case icConnectFailed, icConnectionAborted, _
  109.             icCannotConnect
  110.             MsgBox "Unable to connect to network."
  111.         Case icInetTimeout
  112.             MsgBox "Connection timed out."
  113.         Case icExecuting
  114.             'Cancel previous request
  115.             inetBrowse.Cancel
  116.             'Check whether cancel worked
  117.             If inetBrowse.StillExecuting Then
  118.                 Caption = "Couldn't cancel request."
  119.             'Resubmit current request
  120.             Else
  121.                 Resume
  122.             End If
  123.         Case Else
  124.             Debug.Print Err.Number, Err.Description
  125.         End Select
  126. End Sub
  127.  
  128. Private Sub txtContents_DblClick()
  129.     'Browse selected directory
  130.     If txtContents.SelLength Then
  131.         'If selection is a directory
  132.         If Right(txtContents.SelText, 1) = "/" Then
  133.             'Add selected item to address
  134.             txtAddress = txtAddress & "/" & _
  135.               Left(txtContents.SelText, _
  136.               txtContents.SelLength - 1)
  137.             'Trap errors (important!)
  138.             On Error GoTo errBrowse
  139.             'Show directory
  140.             mstrDir = Right(txtAddress, Len(txtAddress) _
  141.               - Len(inetBrowse.URL))
  142.             inetBrowse.Execute , "Dir " & mstrDir & "/*"
  143.         'Otherwise, it's a file, so retrieve it
  144.         Else
  145.             Dim strFilename
  146.             'Build pathname of file
  147.             mstrDir = Right(txtAddress, Len(txtAddress) _
  148.               - Len(inetBrowse.URL)) & "/" & _
  149.               txtContents.SelText
  150.             mstrDir = Right(mstrDir, Len(mstrDir) - 1)
  151.             strFilename = mstrDir
  152.             Do
  153.                 strFilename = Right(strFilename, _
  154.                     Len(strFilename) - InStr(strFilename, "/"))
  155.             Loop Until InStr(strFilename, "/") = 0
  156.             'Retrieve file
  157.             inetBrowse.Execute , "Get " & mstrDir & _
  158.                 " " & mstrTempDir & strFilename
  159.         End If
  160.     End If
  161.     Exit Sub
  162. errBrowse:
  163.     If Err = icExecuting Then
  164.         'Cancel previous request
  165.         inetBrowse.Cancel
  166.         'Check whether cancel worked
  167.         If inetBrowse.StillExecuting Then
  168.             Caption = "Couldn't cancel request."
  169.         'Resubmit current request
  170.         Else
  171.             Resume
  172.         End If
  173.     Else
  174.         'Display error
  175.         Debug.Print Err & " " & Err.Description
  176.     End If
  177. End Sub
  178.  
  179.  
  180. Private Sub inetBrowse_StateChanged(ByVal State As Integer)
  181.     Select Case State
  182.         Case icError
  183.             Debug.Print inetBrowse.ResponseCode & " " & _
  184.               inetBrowse.ResponseInfo
  185.         Case icResolvingHost, icRequesting, icRequestSent
  186.             Caption = "Searching..."
  187.         Case icHostResolved
  188.             Caption = "Found."
  189.         Case icReceivingResponse, icResponseReceived
  190.             Caption = "Receiving data."
  191.         Case icResponseCompleted
  192.             Dim strBuffer As String
  193.             'Get data
  194.             strBuffer = inetBrowse.GetChunk(1024)
  195.             'If data is a directory, display it
  196.             If strBuffer <> "" Then
  197.                 Caption = "Completed."
  198.                 txtContents = strBuffer
  199.             Else
  200.                 Caption = "File saved in " & _
  201.                   mstrTempDir & "."
  202.             End If
  203.         Case icConnecting, icConnected
  204.             Caption = "Connecting."
  205.         Case icDisconnecting
  206.         Case icDisconnected
  207.         Case Else
  208.             Debug.Print State
  209.     End Select
  210. End Sub
  211.